home *** CD-ROM | disk | FTP | other *** search
/ Scene 96 / Scene 96 International Edition (Zyklop Software) (Disc 2) (1997).iso / misc / coding / vgacodng / part06_a.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-12-20  |  2.7 KB  |  110 lines
  1. program RAWDemo;
  2.  
  3. uses crt;
  4.  
  5. var n1,n2 : word;
  6.  
  7. procedure SaveRAW(Name:string);
  8. var f : file;
  9.  
  10. begin
  11.   assign(f,Name);
  12.   rewrite(f,1);                        { Datei erstellen }
  13.   blockwrite(f,mem[$A000:0],64000);
  14.   { Ab Adresse $A000:0 64000 Byte lesen und in die Datei schreiben }
  15.   close(f);                            { Datei wieder schließen }
  16. end;
  17.  
  18. procedure LoadRAW(Name:string);
  19. var f : file;
  20.  
  21. begin
  22.   assign(f,Name);
  23.   reset(f,1);                          { Datei für Lesezugriff vorbereiten }
  24.   blockread(f,mem[$A000:0],64000);
  25.   { 64000 Byte aus Datei lesen und in den Bildschirmspeicher schreiben }
  26.   close(f);
  27. end;
  28.  
  29. procedure GetPal(col:byte;var r,g,b:byte);
  30. begin
  31.   port[$3C7] := Col;
  32.   r := port[$3C9];
  33.   g := port[$3C9];
  34.   b := port[$3C9];
  35. end;
  36.  
  37. procedure SetPal(col:byte;r,g,b:byte);
  38. begin
  39.    port[$3C8] := Col;
  40.    port[$3C9] := r;
  41.    port[$3C9] := g;
  42.    port[$3C9] := b;
  43. end;
  44.  
  45. procedure SavePal(Name:string);
  46. var f   : file;
  47.     n   : byte;
  48.     RGB : array[1..3] of byte;
  49.  
  50. begin
  51.   assign(f,Name);
  52.   rewrite(f,1);
  53.   for n := 0 to 255 do begin
  54.     getpal(n,RGB[1],RGB[2],RGB[3]);
  55.     blockwrite(f,RGB,3);
  56.   end;
  57.   close(f);
  58. end;
  59.  
  60. procedure LoadPal(Name:string);
  61. var f   : file;
  62.     n   : byte;
  63.     RGB : array[1..3] of byte;
  64.  
  65. begin
  66.   assign(f,Name);
  67.   reset(f,1);
  68.   for n := 0 to 255 do begin
  69.     blockread(f,RGB,3);
  70.     setpal(n,RGB[1],RGB[2],RGB[3]);
  71.   end;
  72.   close(f);
  73. end;
  74.  
  75.  
  76. begin
  77.   repeat
  78.     clrscr;
  79.     writeln('Bitte wählen:');
  80.     writeln;
  81.     writeln('1 - Bild aufbauen und BILD.RAW und BILD.PAL auf Platte schreiben');
  82.     writeln('2 - BILD.RAW und BILD.PAL von Platte lesen und anzeigen');
  83.     writeln('3 - Ende');
  84.     case readkey of
  85.       '1' : begin
  86.               asm mov ax,13h; int 10h end;
  87.               for n1 := 1 to 150 do                     { Palette setzen }
  88.                 SetPal(n1,30+n1 div 6,20+n1 div 7,10+n1 div 7);
  89.               for n1 := 1 to 104 do
  90.                 SetPal(150+n1,0,20+n1 div 4,30+n1 div 5);
  91.               for n1 := 0 to 319 do                      { Bild aufbauen }
  92.                 for n2 := 0 to 199 do
  93.                   mem[$A000:n2*320+n1]:=151+(n1*n1+n2*n2) mod 104;
  94.               readkey;
  95.               SaveRAW('PART06_A.RAW');        { Bild sichern }
  96.               SavePAL('PART06_A.PAL');        { Palette sichern }
  97.               asm mov ax,3; int 10h end;
  98.             end;
  99.       '2' : begin
  100.               asm mov ax,13h; int 10h end;
  101.               LoadPAL('PART06_A.PAL');        { Palette laden }
  102.               LoadRAW('PART06_A.RAW');        { Bild laden }
  103.               readkey;
  104.               asm mov ax,3; int 10h end;
  105.             end;
  106.       '3' : halt;
  107.     end;
  108.   until false;
  109. end.
  110.